home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / TVDMXCOL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-16  |  13KB  |  437 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvDMXCOL  --Collection Data Editing Unit    }
  5. {    tvDMX     --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1992  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Unit tvDMXCOL;
  15.  
  16. {$B-,D-,R-,O+,X+,V- }
  17.  
  18. interface
  19.  
  20. uses
  21.     Objects, Drivers, Memory, Views, App, MsgBox,
  22.     RSet, DmxGizma, tvDMX, StdDMX;
  23.  
  24. const
  25.     cmDMX_Reset        =  cmDMX + 49;
  26.  
  27. type
  28.     PDmxCollectView    = ^TDmxCollectView;
  29.     PDmxCollector    = ^TDmxCollector;
  30.     PDmxCollectViewWin    = ^TDmxCollectViewWin;
  31.     PDmxCollectorWin    = ^TDmxCollectorWin;
  32.  
  33.  
  34.     TDmxCollectView    =  OBJECT (TDmxScroller)
  35.       constructor Init (ATemplate : string;  var AData;
  36.             var Bounds : TRect;  ALabels : PView;
  37.             AHScrollBar,AVScrollBar : PScrollBar);
  38.       procedure InitData (var AData );  VIRTUAL;
  39.       procedure SetState (AState : word; Enable : boolean);  VIRTUAL;
  40.       function  DataAt (RecNum : integer) : pointer;  VIRTUAL;
  41.     end;
  42.  
  43.  
  44.     TDmxCollector    =  OBJECT (TDmxEditor)
  45.         NewDataRec : pointer;
  46.         MaxCount   : integer;
  47.         MemWarning : boolean;
  48.       procedure LoadStruct (var S : TStream);  VIRTUAL;
  49.       procedure StoreStruct (var S : TStream);  VIRTUAL;
  50.       procedure InitData (var AData );  VIRTUAL;
  51.       procedure InitNewDataRec;
  52.       procedure DoneData;  VIRTUAL;
  53.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  54.       function  Valid (Command : word) : boolean;  VIRTUAL;
  55.       procedure SetState (AState : word; Enable : boolean);  VIRTUAL;
  56.       function  DataAt (RecNum : integer) : pointer;  VIRTUAL;
  57.       procedure SetupRecord;  VIRTUAL;
  58.       procedure EvaluateRecord;  VIRTUAL;
  59.       procedure ZeroizeRecord;  VIRTUAL;
  60.     end;
  61.  
  62.  
  63.     TDmxCollectViewWin    =  OBJECT (TDmxViewer)
  64.       constructor Init (var Bounds : TRect;  ATitle : TTitleStr;
  65.             ANumber : integer;  ATemplate : string;
  66.             ACollection : PCollection;  var ALabels : string);
  67.       procedure InitDMX (ATemplate  : string;  var AData;
  68.                          ALabels, ARecInd  : PDmxLink;
  69.                          BSize  : longint);  VIRTUAL;
  70.     end;
  71.  
  72.  
  73.     TDmxCollectorWin    =  OBJECT (TDmxWindow)
  74.       constructor Init (var Bounds : TRect;
  75.            ATitle    : TTitleStr;  ANumber  : integer;
  76.            ATemplate : string;  ACollection : PCollection;
  77.            BSize     : integer; var ALabels : string; IndLen : integer);
  78.       procedure InitDMX (ATemplate  : string;  var AData;
  79.                          ALabels, ARecInd  : PDmxLink;
  80.                          BSize  : longint);  VIRTUAL;
  81.     end;
  82.  
  83.  
  84.  
  85.   function  fldObjectVMT (Obj : PObject) : string;
  86.     { template prefix to generate a VMT identifier
  87.       for collections of TObject derivatives
  88.      }
  89.  
  90.   procedure ResetCollection (Collection : PCollection);
  91.     { adjust the size of the database }
  92.  
  93.  
  94. implementation
  95.  
  96.   { ══════════════════════════════════════════════════════════════════════ }
  97.  
  98.  
  99. function  fldObjectVMT (Obj : PObject) : string;
  100. begin
  101.   fldObjectVMT := ^H'c'^V + pchar(Obj)^ + #0^H'c'^V + pstring(Obj)^[1] + #0;
  102.   Dispose (Obj, Done);
  103. end;
  104.  
  105.  
  106. procedure ResetCollection (Collection : PCollection);
  107. { adjust the size of the database }
  108. begin
  109.   Repeat
  110.   Until (Message (DeskTop, evBroadcast, cmDMX_Reset, Collection) = nil)
  111.      or (Collection^.Count > 0);
  112.   Message (DeskTop, evCommand, cmDMX_Reset, Collection);
  113. end;
  114.  
  115.  
  116.   { ══ TDmxCollectView ═══════════════════════════════════════════════════ }
  117.  
  118.  
  119. constructor TDmxCollectView.Init (ATemplate    : string;  var AData;
  120.                   var Bounds    : TRect;
  121.                   ALabels    : PView;
  122.                   AHScrollBar,AVScrollBar : PScrollBar);
  123. begin
  124.   TDmxScroller.Init (ATemplate, AData, 0, Bounds, ALabels, AHScrollBar, AVScrollBar);
  125. end;
  126.  
  127.  
  128. procedure TDmxCollectView.InitData (var AData );
  129. begin
  130.   TDmxScroller.InitData (AData);
  131.   DataBlockSize := (RecordSize * PCollection (WorkingData)^.Count);
  132. end;
  133.  
  134.  
  135. procedure TDmxCollectView.SetState (AState : word; Enable : boolean);
  136. begin
  137.   If Enable and (AState = sfFocused) and
  138.     (DataBlockSize <> RecordSize * PCollection (WorkingData)^.Count) then
  139.     DataBlockSize := RecordSize * PCollection (WorkingData)^.Count;
  140.   TDmxScroller.SetState (AState, Enable);
  141. end;
  142.  
  143.  
  144. function  TDmxCollectView.DataAt (RecNum : integer) : pointer;
  145. begin
  146.   If (PCollection (WorkingData)^.Count <= RecNum) then
  147.     DataAt := nil
  148.    else
  149.     DataAt := PCollection (WorkingData)^.At (RecNum);
  150. end;
  151.  
  152.  
  153.   { ══ TDmxCollector ═════════════════════════════════════════════════════ }
  154.  
  155.  
  156. procedure TDmxCollector.LoadStruct (var S : TStream);
  157. begin
  158.   TDmxEditor.LoadStruct (S);
  159.   S.Read (MaxCount, sizeof (MaxCount));
  160.   InitNewDataRec;
  161. end;
  162.  
  163.  
  164. procedure TDmxCollector.StoreStruct (var S : TStream);
  165. begin
  166.   TDmxEditor.StoreStruct (S);
  167.   S.Write (MaxCount, sizeof (MaxCount));
  168. end;
  169.  
  170.  
  171. procedure TDmxCollector.InitData (var AData );
  172. { this method is called during initialization }
  173. begin
  174.   TDmxEditor.InitData (AData);
  175.  
  176.   { Note that the given database size is used for max record count. }
  177.   Move (DataBlockSize, MaxCount, 2);
  178.  
  179.   DataBlockSize := (RecordSize * PCollection (WorkingData)^.Count);
  180.   If (MaxCount = 0) or (PCollection (WorkingData)^.Count < MaxCount) then
  181.     DataBlockSize := DataBlockSize + RecordSize;
  182.  
  183.   InitNewDataRec;
  184. end;
  185.  
  186.  
  187. procedure TDmxCollector.DoneData;
  188. { this method is called during termination }
  189. begin
  190.   TDmxEditor.DoneData;
  191.   If (NewDataRec <> nil) then FreeMem (NewDataRec, RecordSize);
  192. end;
  193.  
  194.  
  195. procedure TDmxCollector.InitNewDataRec;
  196. { initialize a temporary data object for new records }
  197. begin
  198.   If (RecordSize > 0) then
  199.     begin
  200.     GetMem (NewDataRec, RecordSize);
  201.     RecordData        := NewDataRec;
  202.     TDmxEditor.ZeroizeRecord;
  203.     RecordAltered    := FALSE;
  204.     FieldAltered    := FALSE;
  205.     end
  206.    else
  207.     NewDataRec    := nil;
  208. end;
  209.  
  210.  
  211. procedure TDmxCollector.HandleEvent (var Event : TEvent);
  212. begin
  213.   TDmxEditor.HandleEvent (Event);
  214.   If (Event.What and evMessage <> 0) and (Event.Command = cmDMX_Reset) and
  215.      (Event.InfoPtr = WorkingData) then
  216.     begin
  217.     DataBlockSize := RecordSize;
  218.     DataBlockSize := DataBlockSize * PCollection (WorkingData)^.Count;
  219.     If (MaxCount = 0) or (PCollection (WorkingData)^.Count < MaxCount) then
  220.       DataBlockSize := DataBlockSize + RecordSize;
  221.     If (DataBlockSize <= 0) and (Owner <> nil) and
  222.        (not GetState (sfFocused) or (Event.What = evCommand)) then
  223.       begin
  224.       Event.What := evCommand;
  225.       Event.Command := cmClose;
  226.       Event.InfoPtr := Owner;
  227.       end
  228.      else
  229.       begin
  230.       If RecordSelected then
  231.         begin
  232.         FieldAltered  := FALSE;
  233.         RecordAltered := FALSE;
  234.         EvaluateField;
  235.         EvaluateRecord;
  236.         If (CurrentRecord >= (DataBlockSize div RecordSize)) and
  237.            (DataBlockSize > 0) then
  238.           CurrentRecord := pred (DataBlockSize div RecordSize);
  239.         SetupRecord;
  240.         SetupField;
  241.         end;
  242.       SetLimit (Limit.X, DataBlockSize div RecordSize);
  243.       DrawView;
  244.       If (Event.What = evCommand) then ClearEvent (Event);
  245.       end;
  246.     end;
  247. end;
  248.  
  249.  
  250. function  TDmxCollector.Valid (Command : word) : boolean;
  251. var  V : boolean;
  252. begin
  253.   V := TDmxEditor.Valid (Command);
  254.   If V and (Command = cmValid) and
  255.      ((WorkingData = nil) or (DataBlockSize < RecordSize) or (RecordSize <= 0)) then
  256.     begin
  257.     MessageBox ('No data available.', nil, mfError or mfOKButton);
  258.     Valid := FALSE;
  259.     end
  260.    else
  261.     Valid := V;
  262. end;
  263.  
  264.  
  265. procedure TDmxCollector.SetState (AState : word; Enable : boolean);
  266. { resets the DataBlockSize if the collection's limit has changed }
  267. begin
  268.   If Enable and (AState = sfFocused) and
  269.     (DataBlockSize <> RecordSize * succ (PCollection (WorkingData)^.Count)) then
  270.     begin
  271.     DataBlockSize := RecordSize * PCollection (WorkingData)^.Count;
  272.     If (MaxCount = 0) or (PCollection (WorkingData)^.Count < MaxCount) then
  273.       DataBlockSize := DataBlockSize + RecordSize;
  274.     end;
  275.   TDmxEditor.SetState (ASt